BMUG Revelations/BMUG Revelations.toast/Programming/Programming Languages/UCB Logo 3.0/CSLS/student

Text File | 1992-09-04 | 33KB | 1,157 lines

TO ABS :NUM
OP IFELSE (:NUM < 0) [-:NUM] [:NUM]
END

TO AGEIFY :SENT
IF EMPTYP :SENT [OUTPUT []]
IF NOT PERSONP FIRST :SENT [OUTPUT FPUT FIRST :SENT AGEIFY BF :SENT]
CATCH "ERROR [IF EQUALP FIRST BF :SENT "S ~
                 [OUTPUT FPUT FIRST :SENT AGEIFY BF :SENT]]
OUTPUT (SE FIRST :SENT [S AGE] AGEIFY BF :SENT)
END

TO AGEPROB
LOCAL [BEG END SYM WHO NUM SUBJ AGES]
WHILE [MATCH [^BEG AS OLD AS #END] :PROB] [MAKE "PROB SE :BEG :END]
WHILE [MATCH [^BEG YEARS OLD #END] :PROB] [MAKE "PROB SE :BEG :END]
WHILE [MATCH [^BEG WILL BE WHEN #END] :PROB] ~
      [MAKE "SYM GENSYM ~
       MAKE "PROB (SE :BEG "IN :SYM [YEARS . IN] :SYM "YEARS :END)]
WHILE [MATCH [^BEG WAS WHEN #END] :PROB] ~
      [MAKE "SYM GENSYM ~
       MAKE "PROB (SE :BEG :SYM [YEARS AGO .] :SYM [YEARS AGO] :END)]
WHILE [MATCH [^BEG !WHO:PERSONP WILL BE IN !NUM YEARS #END] :PROB] ~
      [MAKE "PROB (SE :BEG :WHO [S AGE IN] :NUM "YEARS #END)]
WHILE [MATCH [^BEG WAS #END] :PROB] [MAKE "PROB (SE :BEG "IS :END)]
WHILE [MATCH [^BEG WILL BE #END] :PROB] [MAKE "PROB (SE :BEG "IS :END)]
WHILE [MATCH [^BEG !WHO:PERSONP IS NOW #END] :PROB] ~
      [MAKE "PROB (SE :BEG :WHO [S AGE NOW] :END)]
WHILE [MATCH [^BEG !NUM YEARS FROM NOW #END] :PROB] ~
      [MAKE "PROB (SE :BEG "IN :NUM "YEARS :END)]
MAKE "PROB AGEIFY :PROB
IFELSE MATCH [^ !WHO:PERSONP ^END S AGE #] :PROB ~
       [MAKE "SUBJ SE :WHO :END] [MAKE "SUBJ "SOMEONE]
MAKE "PROB AGEPRON :PROB
MAKE "END :PROB
MAKE "AGES []
WHILE [MATCH [^ !WHO:PERSONP ^BEG AGE #END] :END] ~
      [PUSH "AGES (SE "AND :WHO :BEG "AGE)]
MAKE "AGES BF REDUCE "SE REMDUP :AGES
WHILE [MATCH [^BEG THEIR AGES #END] :PROB] [MAKE "PROB (SE :BEG :AGES :END)]
MAKE "SIMSEN MAP [AGESEN ?] BRACKET :PROB
END

TO AGEPRON :SENT
IF EMPTYP :SENT [OUTPUT []]
IF NOT PRONOUN FIRST :SENT [OUTPUT FPUT FIRST :SENT AGEPRON BF :SENT]
IF POSSPRO FIRST :SENT [OUTPUT (SE :SUBJ "S AGEPRON BF :SENT)]
OUTPUT (SE :SUBJ [S AGE] AGEPRON BF :SENT)
END

TO AGESEN :SENT
LOCAL [WHEN REST NUM]
MAKE "WHEN []
IF MATCH [IN !NUM YEARS #REST] :SENT ~
   [MAKE "WHEN SE "PLUSS :NUM MAKE "SENT :REST]
IF MATCH [!NUM YEARS AGO #REST] :SENT ~
   [MAKE "WHEN SE "MINUSS :NUM MAKE "SENT :REST]
OUTPUT AGEWHEN :SENT
END

TO AGEWHEN :SENT
IF EMPTYP :SENT [OUTPUT []]
IF NOT EQUALP FIRST :SENT "AGE [OUTPUT FPUT FIRST :SENT AGEWHEN BF :SENT]
IF MATCH [IN !NUM YEARS #REST] BF :SENT ~
   [OUTPUT (SE [AGE PLUSS] :NUM AGEWHEN :REST)]
IF MATCH [!NUM YEARS AGO #REST] BF :SENT ~
   [OUTPUT (SE [AGE MINUSS] :NUM AGEWHEN :REST)]
IF EQUALP "NOW FIRST BF :SENT [OUTPUT SE "AGE AGEWHEN BF BF :SENT]
OUTPUT (SE "AGE :WHEN AGEWHEN BF :SENT)
END

TO ARTICLE :WORD
OP MEMBERP :WORD [A AN THE]
END

TO BKT1 :PROBLIST
LOCAL [FIRST WORD REST]
IF EMPTYP :PROBLIST [OUTPUT []]
IF NOT MEMBERP ", FIRST :PROBLIST [OP FPUT FIRST :PROBLIST BKT1 BF :PROBLIST]
IF MATCH [IF ^FIRST , !WORD:QWORD #REST] FIRST :PROBLIST ~
   [OP BKT1 FPUT (SE :FIRST ".) FPUT (SE :WORD :REST) BF :PROBLIST]
IF MATCH [^FIRST , AND #REST] FIRST :PROBLIST ~
   [OP FPUT (SE :FIRST ".) (BKT1 FPUT :REST BF :PROBLIST)]
OP FPUT FIRST :PROBLIST BKT1 BF :PROBLIST
END

TO BRACKET :PROB
OUTPUT BKT1 FINDDELIM :PROB
END

TO CHANGEONE :CHANGE
LOCAL "END
IF NOT MATCH (SE FIRST :CHANGE [#END]) :SENT [OP "FALSE]
MAKE "SENT RUN (SE "SE LAST :CHANGE ":END)
OP "TRUE
END

TO CHANGES :SENT :LIST
LOCAL "KEYWORDS
MAKE "KEYWORDS MAP.SE [FINDKEY FIRST ?] :LIST
OP CHANGES1 :SENT :LIST :KEYWORDS
END

TO CHANGES1 :SENT :LIST :KEYWORDS
IF EMPTYP :SENT [OP []]
IF MEMBERP FIRST :SENT :KEYWORDS [OP CHANGES2 :SENT :LIST :KEYWORDS]
OP FPUT FIRST :SENT CHANGES1 BF :SENT :LIST :KEYWORDS
END

TO CHANGES2 :SENT :LIST :KEYWORDS
CHANGES3 :LIST :LIST
OP FPUT FIRST :SENT CHANGES1 BF :SENT :LIST :KEYWORDS
END

TO CHANGES3 :BIGLIST :NOWLIST
IF EMPTYP :NOWLIST [STOP]
IF CHANGEONE FIRST :NOWLIST [CHANGES3 :BIGLIST :BIGLIST STOP]
CHANGES3 :BIGLIST BF :NOWLIST
END

TO DENOM :FRACT :ADDENDS
MAKE "ADDENDS SIMPLUS :ADDENDS
LOCAL "DEN
MAKE "DEN LAST :FRACT
IF NOT EQUALP FIRST :ADDENDS "QUOTIENT ~
   [OP SIMDIV LIST ~
               (SIMONE "SUM ~
                       (REMOP "SUM LIST (DISTRIBTIMES (LIST :ADDENDS) :DEN) ~
                                        FIRST BF :FRACT)) :DEN]
IF EQUALP :DEN LAST :ADDENDS ~
   [OP SIMDIV (SIMPLUS LIST (FIRST BF :FRACT) (FIRST BF :ADDENDS)) :DEN]
LOCAL "LOWTERMS
MAKE "LOWTERMS SIMDIV LIST :DEN LAST :ADDENDS
OP SIMDIV LIST (SIMPLUS (SIMTIMES LIST FIRST BF :FRACT LAST :LOWTERMS) ~
                        (SIMTIMES LIST FIRST BF :ADDENDS FIRST BF :LOWTERMS)) ~
               (SIMTIMES LIST FIRST BF :LOWTERMS LAST :ADDENDS)
END

TO DEPUNCT :WORD
IF EMPTYP :WORD [OP []]
IF EQUALP FIRST :WORD "$ [OP SE "$ DEPUNCT BF :WORD]
IF EQUALP LAST :WORD "% [OP SE DEPUNCT BL :WORD "PERCENT]
IF MEMBERP LAST :WORD [. ? |;| ,] [OP SE DEPUNCT BL :WORD LAST :WORD]
IF EMPTYP BF :WORD [OP :WORD]
IF EQUALP LAST2 :WORD "'S [OP SE DEPUNCT BL BL :WORD "S]
OP :WORD
END

TO DISTRIBTIMES :TRMS :MULTIPLIER
OP SIMPLUS MAP [SIMTIMES (LIST ? :MULTIPLIER)] :TRMS
END

TO DISTRIBX :EXPR
LOCAL [OPER ARGS]
IF EMPTYP :EXPR [OP :EXPR]
MAKE "OPER FIRST :EXPR
IF NOT OPERATORP :OPER [OP :EXPR]
MAKE "ARGS MAP [DISTRIBX ?] BF :EXPR
IF REDUCE "AND MAP [NUMBERP ?] :ARGS [OP RUN (SE [(] :OPER :ARGS [)])]
IF EQUALP :OPER "SUM [OP SIMPLUS :ARGS]
IF EQUALP :OPER "MINUS [OP MINUSIN FIRST :ARGS]
IF EQUALP :OPER "PRODUCT [OP SIMTIMES :ARGS]
IF EQUALP :OPER "QUOTIENT [OP SIMDIV :ARGS]
OP FPUT :OPER :ARGS
END

TO DIVTERM :DIVIDEND :DIVISOR
IF EQUALP :DIVIDEND 0 [OP 0]
OP SIMDIV LIST :DIVIDEND :DIVISOR
END

TO DLM :WORD
OP MEMBERP :WORD [. ? |;|]
END

TO EXPT :NUM :POW
IF :POW < 1 [OP 1]
OP :NUM * EXPT :NUM :POW - 1
END

TO FACTOR :EXPRS :VAR
LOCAL "TRMS
MAKE "TRMS MAP [FACTOR1 :VAR ?] :EXPRS
IF MEMBERP "UNKNOWN :TRMS [OP FPUT "UNKNOWN :EXPRS]
OP LIST :VAR SIMPLUS :TRMS
END

TO FACTOR1 :VAR :EXPR
LOCAL "NEGVAR
MAKE "NEGVAR MINUSIN :VAR
IF EQUALP :VAR :EXPR [OP 1]
IF EQUALP :NEGVAR :EXPR [OP -1]
IF EMPTYP :EXPR [OP "UNKNOWN]
IF EQUALP FIRST :EXPR "PRODUCT [OP FACTOR2 BF :EXPR]
IF NOT EQUALP FIRST :EXPR "QUOTIENT [OP "UNKNOWN]
LOCAL "DIVIDEND
MAKE "DIVIDEND FIRST BF :EXPR
IF EQUALP :VAR :DIVIDEND [OP (LIST "QUOTIENT 1 LAST :EXPR)]
IF NOT EQUALP FIRST :DIVIDEND "PRODUCT [OP "UNKNOWN]
LOCAL "RESULT
MAKE "RESULT FACTOR2 BF :DIVIDEND
IF EQUALP :RESULT "UNKNOWN [OP "UNKNOWN]
OP (LIST "QUOTIENT :RESULT LAST :EXPR)
END

TO FACTOR2 :TRMS
IF MEMBERP :VAR :TRMS [OP SIMONE "PRODUCT (REMOVE :VAR :TRMS)]
IF MEMBERP :NEGVAR :TRMS [OP MINUSIN SIMONE "PRODUCT (REMOVE :NEGVAR :TRMS)]
OP "UNKNOWN
END

TO FINDDELIM :SENT
OP FINDDELIM1 :SENT [] []
END

TO FINDDELIM1 :IN :OUT :SIMPLES
IF EMPTYP :IN ~
   [IFELSE EMPTYP :OUT [OP :SIMPLES] [OP LPUT (SE :OUT ".) :SIMPLES]]
IF DLM FIRST :IN ~
   [OP FINDDELIM1 (BF :IN) [] (LPUT (SE :OUT FIRST :IN) :SIMPLES)]
OP FINDDELIM1 (BF :IN) (SE :OUT FIRST :IN) :SIMPLES
END

TO FINDKEY :PATTERN
IF EQUALP FIRST :PATTERN "!:IN [OP FIRST BF :PATTERN]
IF EQUALP FIRST :PATTERN "?:IN [OP SE (ITEM 2 :PATTERN) (ITEM 3 :PATTERN)]
OP FIRST :PATTERN
END

TO GETEQNS :VARS
OP MAP.SE [GPROP VARKEY ? "EQNS] :VARS
END

TO IDIOMS :SENT
LOCAL "NUMBER
OP CHANGES :SENT ~
    [[[THE SUM OF] ["SUM]] [[SQUARE OF] ["SQUARE]] [[OF] ["NUMOF]] ~
     [[HOW OLD] ["WHAT]] [[IS EQUAL TO] ["IS]] ~
     [[YEARS YOUNGER THAN] [[LESS THAN]]] [[YEARS OLDER THAN] ["PLUS]] ~
     [[PERCENT LESS THAN] ["PERLESS]] [[LESS THAN] ["LESSTHAN]] ~
     [[THESE] ["THE]] [[MORE THAN] ["PLUS]] ~
     [[FIRST TWO NUMBERS] [[THE FIRST NUMBER AND THE SECOND NUMBER]]] ~
     [[THREE NUMBERS] ~
      [[THE FIRST NUMBER AND THE SECOND NUMBER AND THE THIRD NUMBER]]] ~
     [[ONE HALF] [0.5]] [[TWICE] [[2 TIMES]]] ~
     [[$ !NUMBER] [SE :NUMBER "DOLLARS]] [[CONSECUTIVE TO] [[1 PLUS]]] ~
     [[LARGER THAN] ["PLUS]] [[PER CENT] ["PERCENT]] [[HOW MANY] ["HOWM]] ~
     [[IS MULTIPLIED BY] ["ISMULBY]] [[IS DIVIDED BY] ["ISDIVBY]] ~
     [[MULTIPLIED BY] ["TIMES]] [[DIVIDED BY] ["DIVBY]]]
END

TO LAST2 :WORD
OP WORD (LAST BL :WORD) (LAST :WORD)
END

TO LSAY :HERALD :TEXT
PR []
PR :HERALD
PR []
FOREACH :TEXT [PR ? PR []]
END

TO MAYBEADD :NUM :REST
IF EQUALP :NUM 0 [OP :REST]
OP FPUT :NUM :REST
END

TO MAYBEMUL :NUM :REST
IF EQUALP :NUM 1 [OP :REST]
OP FPUT :NUM :REST
END

TO MINUSIN :EXPR
IF EMPTYP :EXPR [OP -1]
IF EQUALP FIRST :EXPR "SUM [OP FPUT "SUM MAP [MINUSIN ?] BF :EXPR]
IF EQUALP FIRST :EXPR "MINUS [OP LAST :EXPR]
IF MEMBERP FIRST :EXPR [PRODUCT QUOTIENT] ~
   [OP FPUT FIRST :EXPR (FPUT (MINUSIN FIRST BF :EXPR) BF BF :EXPR)]
IF NUMBERP :EXPR [OP MINUS :EXPR]
OP LIST "MINUS :EXPR
END

TO NMTEST :EXPR
IF MATCH [& !:NUMBERP #] :EXPR [SAY [ARGUMENT ERROR:] :EXPR TOPLEVEL]
IF AND (EQUALP FIRST :EXPR 1) (1 < COUNT :EXPR) ~
   [MAKE "EXPR (SE 1 PLURAL (FIRST BF :EXPR) (BF BF :EXPR))]
IF AND (NUMBERP FIRST :EXPR) (1 < COUNT :EXPR) ~
   [PUSH "UNITS (LIST FIRST BF :EXPR) ~
    OP (LIST "PRODUCT (FIRST :EXPR) (OPFORM BF :EXPR))]
IF NUMBERP FIRST :EXPR [OP FIRST :EXPR]
IF MEMBERP "THIS :EXPR [OP THIS :EXPR]
IF NOT MEMBERP :EXPR :VAR [PUSH "VAR :EXPR]
OP :EXPR
END

TO OCCVAR :VAR :EXPR
IF EMPTYP :EXPR [OP "FALSE]
IF WORDP :EXPR [OP EQUALP :VAR :EXPR]
IF OPERATORP FIRST :EXPR [OP NOT EMPTYP FIND [OCCVAR :VAR ?] BF :EXPR]
OP EQUALP :VAR :EXPR
END

TO OP0 :WORD
OP MEMBERP :WORD [PLUSS MINUSS SQUARED TOTHEPOWER PER SUM DIFFERENCE NUMOF]
END

TO OP1 :WORD
OP MEMBERP :WORD [TIMES DIVBY SQUARE]
END

TO OP2 :WORD
OP MEMBERP :WORD [PLUS MINUS LESSTHAN PERCENT PERLESS]
END

TO OPDIFF :LEFT :RIGHT
OP (LIST "SUM :LEFT (LIST "MINUS :RIGHT))
END

TO OPERATORP :WORD
OP MEMBERP :WORD [SUM MINUS PRODUCT QUOTIENT EXPT SQUARE EQUAL]
END

TO OPFORM :EXPR
LOCAL [LEFT RIGHT OP]
IF MATCH [^LEFT !OP:OP2 #RIGHT] :EXPR [OP OPTEST :OP :LEFT :RIGHT]
IF MATCH [^LEFT !OP:OP1 #RIGHT] :EXPR [OP OPTEST :OP :LEFT :RIGHT]
IF MATCH [^LEFT !OP:OP0 #RIGHT] :EXPR [OP OPTEST :OP :LEFT :RIGHT]
IF MATCH [#LEFT !:DLM] :EXPR [MAKE "EXPR :LEFT]
OP NMTEST FILTER [NOT ARTICLE ?] :EXPR
END

TO OPREM :SENT
OP MAP [IFELSE EQUALP ? "NUMOF ["OF] [?]] :SENT
END

TO OPTEST :OP :LEFT :RIGHT
OP RUN (LIST (WORD "TST. :OP) :LEFT :RIGHT)
END

TO PERSONP :WORD
OUTPUT MEMBERP :WORD [MARY ANN BILL FATHER UNCLE]
END

TO PLURAL :WORD
LOCAL "PLURAL
MAKE "PLURAL GPROP :WORD "PLURAL
IF NOT EMPTYP :PLURAL [OP :PLURAL]
IF NOT EMPTYP GPROP :WORD "SING [OP :WORD]
IF EQUALP LAST :WORD "S [OP :WORD]
OP WORD :WORD "S
END

TO POSSPRO :WORD
OP MEMBERP :WORD [HIS HER ITS]
END

TO PRANS :ANS :SOLUTION
LOCAL "RESULT
MAKE "RESULT FIND [EQUALP FIRST ? FIRST :ANS] :SOLUTION
IF EMPTYP :RESULT [OP "TRUE]
PR (SE LAST :ANS "IS UNITSTRING LAST :RESULT)
PR []
OP "FALSE
END

TO PRANSWERS :ANS :SOLUTION
PR []
IF EQUALP :SOLUTION "UNSOLVABLE ~
   [PR [UNABLE TO SOLVE THIS SET OF EQUATIONS.] OP "FALSE]
IF EQUALP :SOLUTION "INSUFFICIENT ~
   [PR [THE EQUATIONS WERE INSUFFICIENT TO FIND A SOLUTION.] OP "FALSE]
LOCAL "GOTALL
MAKE "GOTALL "TRUE
FOREACH :ANS [IF PRANS ? :SOLUTION [MAKE "GOTALL "FALSE]]
IF NOT :GOTALL [PR [] PR [UNABLE TO SOLVE THIS SET OF EQUATIONS.]]
OP :GOTALL
END

TO PRONOUN :WORD
OP MEMBERP :WORD [HE SHE IT HIM HER THEY THEM HIS HER ITS]
END

TO QSET :SENT
LOCAL "OPFORM
MAKE "OPFORM OPFORM FILTER [NOT ARTICLE ?] :SENT
IF NOT OPERATORP FIRST :OPFORM ~
   [QUEUE "WANTED :OPFORM QUEUE "ANS LIST :OPFORM OPREM :SENT OP []]
LOCAL "GENSYM
MAKE "GENSYM GENSYM
QUEUE "WANTED :GENSYM
QUEUE "ANS LIST :GENSYM OPREM :SENT
OP (LIST "EQUAL :GENSYM OPFORM (FILTER [NOT ARTICLE ?] :SENT))
END

TO QWORD :WORD
OP MEMBERP :WORD [FIND WHAT HOWM HOW]
END

TO REMFACTOR :NUM :DEN
FOREACH BF :NUM [REMFACTOR1 ?]
OP (LIST "QUOTIENT (SIMONE "PRODUCT BF :NUM) (SIMONE "PRODUCT BF :DEN))
END

TO REMFACTOR1 :EXPR
LOCAL "NEG
IF MEMBERP :EXPR :DEN ~
   [MAKE "NUM REMOVE :EXPR :NUM MAKE "DEN REMOVE :EXPR :DEN STOP]
MAKE "NEG MINUSIN :EXPR
IF NOT MEMBERP :NEG :DEN [STOP]
MAKE "NUM REMOVE :EXPR :NUM
MAKE "DEN MINUSIN REMOVE :NEG :DEN
END

TO REMOP :OPER :EXPRS
OP MAP.SE [IFELSE EQUALP FIRST ? :OPER [BF ?] [(LIST ?)]] :EXPRS
END

TO ROUNDOFF :NUM
IF (ABS (:NUM - ROUND :NUM)) < 0.0001 [OP ROUND :NUM]
OP :NUM
END

TO SAY :HERALD :TEXT
PR []
PR :HERALD
PR []
PR :TEXT
PR []
END

TO SENFORM :SENT
MAKE "LASTEQN SENFORM1 :SENT
OP :LASTEQN
END

TO SENFORM1 :SENT
LOCAL [ONE TWO VERB1 VERB2 STUFF1 STUFF2 FACTOR]
IF EMPTYP :SENT [OP []]
IF MATCH [^ WHAT ARE ^ONE AND ^TWO !:DLM] :SENT ~
   [OP FPUT (QSET :ONE) (SENFORM (SE [WHAT ARE] :TWO "?))]
IF MATCH [^ WHAT !:IN [IS ARE] #ONE !:DLM] :SENT ~
   [OP (LIST QSET :ONE)]
IF MATCH [^ HOWM !ONE IS #TWO !:DLM] :SENT ~
   [PUSH "AUNITS (LIST :ONE) OP (LIST QSET :TWO)]
IF MATCH [^ HOWM ^ONE DO ^TWO HAVE !:DLM] :SENT ~
   [OP (LIST QSET (SE [THE NUMBER OF] :ONE :TWO "HAVE))]
IF MATCH [^ HOWM ^ONE DOES ^TWO HAVE !:DLM] :SENT ~
   [OP (LIST QSET (SE [THE NUMBER OF] :ONE :TWO "HAS))]
IF MATCH [^ FIND ^ONE AND #TWO] :SENT ~
   [OP FPUT (QSET :ONE) (SENFORM SE "FIND :TWO)]
IF MATCH [^ FIND #ONE !:DLM] :SENT [OP (LIST QSET :ONE)]
MAKE "SENT FILTER [NOT ARTICLE ?] :SENT
IF MATCH [^ONE ISMULBY #TWO] :SENT ~
   [PUSH "REF (LIST "PRODUCT OPFORM :ONE OPFORM :TWO) OP []]
IF MATCH [^ONE ISDIVBY #TWO] :SENT ~
   [PUSH "REF (LIST "QUOTIENT OPFORM :ONE OPFORM :TWO) OP []]
IF MATCH [^ONE IS INCREASED BY #TWO] :SENT ~
   [PUSH "REF (LIST "SUM OPFORM :ONE OPFORM :TWO) OP []]
IF MATCH [^ONE IS #TWO] :SENT ~
   [OP (LIST (LIST "EQUAL OPFORM :ONE OPFORM :TWO))]
IF MATCH ~
     [^ONE !VERB1:VERB ^FACTOR AS MANY ^STUFF1 AS ^TWO !VERB2:VERB ^STUFF2 !:DLM] ~
     :SENT ~
   [IF EMPTYP :STUFF2 [MAKE "STUFF2 :STUFF1] ~
    OP (LIST (LIST "EQUAL ~
                   OPFORM (SE [THE NUMBER OF] :STUFF1 :ONE :VERB1) ~
                   OPFORM (SE :FACTOR [THE NUMBER OF] :STUFF2 :TWO :VERB2)))]
IF MATCH [^ONE !VERB1:VERB !FACTOR:NUMBERP #STUFF1 !:DLM] :SENT ~
   [OP (LIST (LIST "EQUAL ~
                   OPFORM (SE [THE NUMBER OF] :STUFF1 :ONE :VERB1) ~
                   OPFORM (LIST :FACTOR)))]
SAY [THIS SENTENCE FORM IS NOT RECOGNIZED:] :SENT
TOPLEVEL
END

TO SETMINUS :BIG :LITTLE
OP FILTER [NOT MEMBERP ? :LITTLE] :BIG
END

TO SIMDIV :LIST
LOCAL [NUM DEN NUMOP DENOP]
MAKE "NUM FIRST :LIST
MAKE "DEN LAST :LIST
IF EQUALP :NUM :DEN [OP 1]
IF NUMBERP :DEN [OP SIMTIMES (LIST (QUOTIENT 1 :DEN) :NUM)]
MAKE "NUMOP FIRST :NUM
MAKE "DENOP FIRST :DEN
IF EQUALP :NUMOP "QUOTIENT ~
   [OP SIMDIV LIST (FIRST BF :NUM) (SIMTIMES LIST LAST :NUM :DEN)]
IF EQUALP :DENOP "QUOTIENT ~
   [OP SIMDIV LIST (SIMTIMES LIST :NUM LAST :DEN) (FIRST BF :DEN)]
IF AND EQUALP :NUMOP "PRODUCT EQUALP :DENOP "PRODUCT [OP REMFACTOR :NUM :DEN]
IF AND EQUALP :NUMOP "PRODUCT MEMBERP :DEN :NUM [OP REMOVE :DEN :NUM]
OP FPUT "QUOTIENT :LIST
END

TO SIMONE :OPER :TRMS
IF EMPTYP :TRMS [OP IFELSE EQUALP :OPER "PRODUCT [1] [0]]
IF EMPTYP BF :TRMS [OP FIRST :TRMS]
OP FPUT :OPER :TRMS
END

TO SIMPLUS :EXPRS
MAKE "EXPRS REMOP "SUM :EXPRS
LOCAL "FACTOR
MAKE "FACTOR [UNKNOWN]
CATCH "SIMPLUS ~
      [FOREACH :TERMS ~
               [MAKE "FACTOR (FACTOR :EXPRS ?) ~
                IF NOT EQUALP FIRST :FACTOR "UNKNOWN [THROW "SIMPLUS]]]
IF NOT EQUALP FIRST :FACTOR "UNKNOWN [OP FPUT "PRODUCT REMOP "PRODUCT :FACTOR]
LOCAL [NUMS NONNUMS QUICK]
MAKE "NUMS 0
MAKE "NONNUMS []
MAKE "QUICK []
CATCH "SIMPLUS [SIMPLUS1 :EXPRS]
IF NOT EMPTYP :QUICK [OP :QUICK]
IF NOT EQUALP :NUMS 0 [PUSH "NONNUMS :NUMS]
OP SIMONE "SUM :NONNUMS
END

TO SIMPLUS1 :EXPRS
IF EMPTYP :EXPRS [STOP]
SIMPLUS2 FIRST :EXPRS
SIMPLUS1 BF :EXPRS
END

TO SIMPLUS2 :POS
LOCAL "NEG
MAKE "NEG MINUSIN :POS
IF NUMBERP :POS [MAKE "NUMS SUM :POS :NUMS STOP]
IF MEMBERP :NEG BF :EXPRS [MAKE "EXPRS REMOVE :NEG :EXPRS STOP]
IF EQUALP FIRST :POS "QUOTIENT ~
   [MAKE "QUICK (DENOM :POS (MAYBEADD :NUMS SE :NONNUMS BF :EXPRS)) ~
    THROW "SIMPLUS]
PUSH "NONNUMS :POS
END

TO SIMTIMES :EXPRS
LOCAL [NUMS NONNUMS QUICK]
MAKE "NUMS 1
MAKE "NONNUMS []
MAKE "QUICK []
CATCH "SIMTIMES [FOREACH REMOP "PRODUCT :EXPRS [SIMTIMES1 ?]]
IF NOT EMPTYP :QUICK [OP :QUICK]
IF EQUALP :NUMS 0 [OP 0]
IF NOT EQUALP :NUMS 1 [PUSH "NONNUMS :NUMS]
OP SIMONE "PRODUCT :NONNUMS
END

TO SIMTIMES1 :EXPR
IF EQUALP :EXPR 0 [MAKE "NUMS 0 THROW "SIMTIMES]
IF NUMBERP :EXPR [MAKE "NUMS PRODUCT :EXPR :NUMS STOP]
IF EQUALP FIRST :EXPR "SUM ~
   [MAKE "QUICK DISTRIBTIMES (BF :EXPR) ~
                             (SIMONE "PRODUCT MAYBEMUL :NUMS SE :NONNUMS ?REST) ~
    THROW "SIMTIMES]
IF EQUALP FIRST :EXPR "QUOTIENT ~
   [MAKE "QUICK ~
          SIMDIV (LIST (SIMTIMES (LIST (FIRST BF :EXPR) ~
                                       (SIMONE "PRODUCT ~
                                               MAYBEMUL :NUMS ~
                                                        SE :NONNUMS ?REST))) ~
                       (LAST :EXPR)) ~
    THROW "SIMTIMES]
PUSH "NONNUMS :EXPR
END

TO SINGULAR :WORD
LOCAL "SING
MAKE "SING GPROP :WORD "SING
IF NOT EMPTYP :SING [OP :SING]
IF NOT EMPTYP GPROP :WORD "PLURAL [OP :WORD]
IF EQUALP LAST :WORD "S [OP BL :WORD]
OP :WORD
END

TO SOLVE :WANTED :EQT :TERMS
OP SOLVE.REDUCE SOLVER :WANTED :TERMS [] [] "INSUFFICIENT
END

TO SOLVE.REDUCE :SOLN
IF EMPTYP :SOLN [OP []]
IF WORDP :SOLN [OP :SOLN]
IF EMPTYP BF :SOLN [OP :SOLN]
LOCAL "PART
MAKE "PART SOLVE.REDUCE BF :SOLN
OP FPUT (LIST (FIRST FIRST :SOLN) (SUBORD LAST FIRST :SOLN :PART)) :PART
END

TO SOLVE1 :X :TERMS :ALIS :EQNS :FAILED :ERR
LOCAL [THISEQ VARS EXTRAS XTERMS OTHERS RESULT]
IF EMPTYP :EQNS [OP :ERR]
MAKE "THISEQ SUBORD (FIRST :EQNS) :ALIS
MAKE "VARS VARTERMS :THISEQ
IF NOT MEMBERP :X :VARS ~
   [OP SOLVE1 :X :TERMS :ALIS (BF :EQNS) (FPUT FIRST :EQNS :FAILED) :ERR]
MAKE "XTERMS FPUT :X :TERMS
MAKE "EXTRAS SETMINUS :VARS :XTERMS
MAKE "EQT REMOVE (FIRST :EQNS) :EQT
IF NOT EMPTYP :EXTRAS ~
   [MAKE "OTHERS SOLVER :EXTRAS :XTERMS :ALIS [] "INSUFFICIENT ~
    IFELSE WORDP :OTHERS ~
           [MAKE "EQT SE :FAILED :EQNS ~
            OP SOLVE1 :X :TERMS :ALIS (BF :EQNS) ~
                      (FPUT FIRST :EQNS :FAILED) :OTHERS] ~
           [MAKE "ALIS :OTHERS ~
            MAKE "THISEQ SUBORD (FIRST :EQNS) :ALIS]]
MAKE "RESULT SOLVEQ :X :THISEQ
IF LISTP :RESULT [OP LPUT :RESULT :ALIS]
MAKE "EQT SE :FAILED :EQNS
OP SOLVE1 :X :TERMS :ALIS (BF :EQNS) (FPUT FIRST :EQNS :FAILED) :RESULT
END

TO SOLVEQ :VAR :EQN
LOCAL [LEFT RIGHT]
MAKE "LEFT FIRST BF :EQN
IFELSE OCCVAR :VAR :LEFT ~
   [MAKE "RIGHT LAST :EQN] [MAKE "RIGHT :LEFT MAKE "LEFT LAST :EQN]
OP SOLVEQ1 :LEFT :RIGHT "TRUE
END

TO SOLVEQ.MINUS
OP SOLVEQ1 (FIRST BF :LEFT) (MINUSIN :RIGHT) "FALSE
END

TO SOLVEQ.PRODUCT
OP SOLVEQ.PRODUCT1 :LEFT :RIGHT
END

TO SOLVEQ.PRODUCT1 :LEFT :RIGHT
IF EMPTYP BF BF :LEFT [OP SOLVEQ1 (FIRST BF :LEFT) :RIGHT "TRUE]
IF NOT OCCVAR :VAR FIRST BF :LEFT ~
   [OP SOLVEQ.PRODUCT1 (FPUT "PRODUCT BF BF :LEFT) ~
                       (DIVTERM :RIGHT FIRST BF :LEFT)]
LOCAL "REST
MAKE "REST SIMONE "PRODUCT BF BF :LEFT
IF OCCVAR :VAR :REST [OP "UNSOLVABLE]
OP SOLVEQ1 (FIRST BF :LEFT) (DIVTERM :RIGHT :REST) "FALSE
END

TO SOLVEQ.QUOTIENT
IF OCCVAR :VAR FIRST BF :LEFT ~
   [OP SOLVEQ1 (FIRST BF :LEFT) (SIMTIMES LIST :RIGHT LAST :LEFT) "TRUE]
OP SOLVEQ1 (SIMTIMES LIST :RIGHT LAST :LEFT) (FIRST BF :LEFT) "TRUE
END

TO SOLVEQ.RPLUS :LEFT :RIGHT :NEWRIGHT
IF EMPTYP :RIGHT [OP SOLVEQ1 :LEFT (SIMONE "SUM :NEWRIGHT) "FALSE]
IF OCCVAR :VAR FIRST :RIGHT ~
   [OP SOLVEQ.RPLUS (SUBTERM :LEFT FIRST :RIGHT) BF :RIGHT :NEWRIGHT]
OP SOLVEQ.RPLUS :LEFT BF :RIGHT (FPUT FIRST :RIGHT :NEWRIGHT)
END

TO SOLVEQ.SUM
IF EMPTYP BF BF :LEFT [OP SOLVEQ1 FIRST BF :LEFT :RIGHT "TRUE]
OP SOLVEQ.SUM1 BF :LEFT :RIGHT []
END

TO SOLVEQ.SUM1 :LEFT :RIGHT :NEWLEFT
IF EMPTYP :LEFT [OP SOLVEQ.SUM2]
IF OCCVAR :VAR FIRST :LEFT ~
   [OP SOLVEQ.SUM1 BF :LEFT :RIGHT FPUT FIRST :LEFT :NEWLEFT]
OP SOLVEQ.SUM1 BF :LEFT (SUBTERM :RIGHT FIRST :LEFT) :NEWLEFT
END

TO SOLVEQ.SUM2
IF EMPTYP BF :NEWLEFT [OP SOLVEQ1 FIRST :NEWLEFT :RIGHT "TRUE]
LOCAL "FACTOR
MAKE "FACTOR FACTOR :NEWLEFT :VAR
IF EQUALP FIRST :FACTOR "UNKNOWN [OP "UNSOLVABLE]
IF EQUALP LAST :FACTOR 0 [OP "UNSOLVABLE]
OP SOLVEQ1 FIRST :FACTOR (DIVTERM :RIGHT LAST :FACTOR) "TRUE
END

TO SOLVEQ1 :LEFT :RIGHT :BOTHTEST
IF :BOTHTEST [IF OCCVAR :VAR :RIGHT [OP SOLVEQBOTH :LEFT :RIGHT]]
IF EQUALP :LEFT :VAR [OP LIST :VAR :RIGHT]
IF WORDP :LEFT [OP "UNSOLVABLE]
LOCAL "OPER
MAKE "OPER FIRST :LEFT
IF MEMBERP :OPER [SUM PRODUCT MINUS QUOTIENT] [OP RUN (LIST WORD "SOLVEQ. :OPER)]
OP "UNSOLVABLE
END

TO SOLVEQBOTH :LEFT :RIGHT
IF NOT EQUALP FIRST :RIGHT "SUM [OP SOLVEQ1 (SUBTERM :LEFT :RIGHT) 0 "FALSE]
OP SOLVEQ.RPLUS :LEFT BF :RIGHT []
END

TO SOLVER :WANTED :TERMS :ALIS :FAILED :ERR
LOCAL [ONE RESULT RESTWANT]
IF EMPTYP :WANTED [OP :ERR]
MAKE "ONE SOLVE1 (FIRST :WANTED) ~
                 (SE BF :WANTED :FAILED :TERMS) :ALIS :EQT [] "INSUFFICIENT
IF WORDP :ONE ~
   [OP SOLVER (BF :WANTED) :TERMS :ALIS (FPUT FIRST :WANTED :FAILED) :ONE]
MAKE "RESTWANT (SE :FAILED BF :WANTED)
IF EMPTYP :RESTWANT [OP :ONE]
MAKE "RESULT SOLVER :RESTWANT :TERMS :ONE [] "INSUFFICIENT
IF LISTP :RESULT [OP :RESULT]
OP SOLVER (BF :WANTED) :TERMS :ALIS (FPUT FIRST :WANTED :FAILED) :ONE
END

TO SQUARE :X
OP :X * :X
END

TO STUDENT :PROB
LOCAL "ORGPROB
SAY [THE PROBLEM TO BE SOLVED IS] :PROB
MAKE "PROB MAP.SE [DEPUNCT ?] :PROB
MAKE "ORGPROB :PROB
STUDENT1 :PROB ~
         [[[THE PERIMETER OF ! RECTANGLE] ~
           [TWICE THE SUM OF THE LENGTH AND WIDTH OF THE RECTANGLE]] ~
          [[TWO NUMBERS] [ONE OF THE NUMBERS AND THE OTHER NUMBER]] ~
          [[TWO NUMBERS] [ONE NUMBER AND THE OTHER NUMBER]]]
END

TO STUDENT1 :PROB :IDIOMS
LOCAL [SIMSEN SHELF AUNITS UNITS WANTED ANS VAR LASTEQN ~
        REF EQT1 BEG END IDIOM REPLY]
MAKE "PROB IDIOMS :PROB
IF MATCH [^ TWO NUMBERS #] :PROB ~
   [MAKE "IDIOM FIND [MATCH (SE "^BEG FIRST ? "#END) :ORGPROB] :IDIOMS ~
    TRYIDIOM STOP]
WHILE [MATCH [^BEG THE THE #END] :PROB] [MAKE "PROB (SE :BEG "THE :END)]
SAY [WITH MANDATORY SUBSTITUTIONS THE PROBLEM IS] :PROB
IFELSE MATCH [# @:IN [[AS OLD AS] [AGE] [YEARS OLD]] #] :PROB ~
       [AGEPROB] [MAKE "SIMSEN BRACKET :PROB]
LSAY [THE SIMPLE SENTENCES ARE] :SIMSEN
MAKE "AUNITS []
MAKE "WANTED []
MAKE "ANS []
MAKE "VAR []
MAKE "LASTEQN []
MAKE "REF []
MAKE "UNITS []
MAKE "SHELF FILTER [NOT EMPTYP ?] MAP.SE [SENFORM ?] :SIMSEN
LSAY [THE EQUATIONS TO BE SOLVED ARE] :SHELF
MAKE "UNITS REMDUP :UNITS
IF TRYSOLVE :SHELF :WANTED :UNITS :AUNITS [PR [THE PROBLEM IS SOLVED.] STOP]
MAKE "EQT1 REMDUP GETEQNS :VAR
IF NOT EMPTYP :EQT1 [LSAY [USING THE FOLLOWING KNOWN RELATIONSHIPS] :EQT1]
STUDENT2 :EQT1
END

TO STUDENT2 :EQT1
MAKE "VAR REMDUP SE (MAP.SE [VARTERMS ?] :EQT1) :VAR
MAKE "EQT1 SE :EQT1 VARTEST :VAR
IF NOT EMPTYP :EQT1 ~
   [IF TRYSOLVE (SE :SHELF :EQT1) :WANTED :UNITS :AUNITS ~
       [PR [THE PROBLEM IS SOLVED.] STOP]]
MAKE "IDIOM FIND [MATCH (SE "^BEG FIRST ? "#END) :ORGPROB] :IDIOMS
IF NOT EMPTYP :IDIOM [TRYIDIOM STOP]
LSAY [DO YOU KNOW ANY MORE RELATIONSHIPS AMONG THESE VARIABLES?] :VAR
MAKE "REPLY RL
IF EQUALP :REPLY [YES] [PR [TELL ME.] MAKE "REPLY RL]
IF EQUALP :REPLY [NO] [PR [] PR [I CAN'T SOLVE THIS PROBLEM.] STOP]
MAKE "REPLY MAP.SE [DEPUNCT ?] :REPLY
IF DLM LAST :REPLY [MAKE "REPLY BL :REPLY]
IF NOT MATCH [^BEG IS #END] :REPLY [PR [I DON'T UNDERSTAND THAT.] STOP]
MAKE "SHELF SE :SHELF :EQT1
STUDENT2 (LIST (LIST "EQUAL OPFORM :BEG OPFORM :END))
END

TO SUBORD :EXPR :ALIST
OP DISTRIBX SUBORD1 :EXPR :ALIST
END

TO SUBORD1 :EXPR :ALIST
IF EMPTYP :ALIST [OP :EXPR]
OP SUBORD (SUBSTOP (LAST FIRST :ALIST) (FIRST FIRST :ALIST) :EXPR) ~
          (BF :ALIST)
END

TO SUBSTOP :VAL :VAR :EXPR
IF EMPTYP :EXPR [OP []]
IF EQUALP :EXPR :VAR [OP :VAL]
IF NOT OPERATORP FIRST :EXPR [OP :EXPR]
OP FPUT FIRST :EXPR MAP [SUBSTOP :VAL :VAR ?] BF :EXPR
END

TO SUBTERM :MINUEND :SUBTRAHEND
IF EQUALP :MINUEND 0 [OP MINUSIN :SUBTRAHEND]
IF EQUALP :MINUEND :SUBTRAHEND [OP 0]
OP SIMPLUS (LIST :MINUEND MINUSIN :SUBTRAHEND)
END

TO THIS :EXPR
IF NOT EMPTYP :REF [OP POP "REF]
IF NOT EMPTYP :LASTEQN [OP FIRST BF LAST :LASTEQN]
IF EQUALP FIRST :EXPR "THIS [MAKE "EXPR BF :EXPR]
PUSH "VAR :EXPR
OP :EXPR
END

TO TRYIDIOM
MAKE "PROB (SE :BEG LAST :IDIOM :END)
WHILE [MATCH (SE "^BEG FIRST :IDIOM "#END) :PROB] ~
      [MAKE "PROB (SE :BEG LAST :IDIOM :END)]
SAY [THE PROBLEM WITH AN IDIOMATIC SUBSTITUTION IS] :PROB
STUDENT1 :PROB (REMOVE :IDIOM :IDIOMS)
END

TO TRYSOLVE :SHELF :WANTED :UNITS :AUNITS
LOCAL "SOLUTION
MAKE "SOLUTION SOLVE :WANTED :SHELF (IFELSE EMPTYP :AUNITS [:UNITS] [:AUNITS])
OP PRANSWERS :ANS :SOLUTION
END

TO TST.DIFFERENCE :LEFT :RIGHT
LOCAL [ONE TWO]
IF MATCH [BETWEEN ^ONE AND #TWO] :RIGHT [OP OPDIFF OPFORM :ONE OPFORM :TWO]
SAY [INCORRECT USE OF DIFFERENCE:] :RIGHT
TOPLEVEL
END

TO TST.DIVBY :LEFT :RIGHT
OP (LIST "QUOTIENT OPFORM :LEFT OPFORM :RIGHT)
END

TO TST.LESSTHAN :LEFT :RIGHT
OP OPDIFF OPFORM :RIGHT OPFORM :LEFT
END

TO TST.MINUS :LEFT :RIGHT
IF EMPTYP :LEFT [OP LIST "MINUS OPFORM :RIGHT]
OP OPDIFF OPFORM :LEFT OPFORM :RIGHT
END

TO TST.MINUSS :LEFT :RIGHT
OP TST.MINUS :LEFT :RIGHT
END

TO TST.NUMOF :LEFT :RIGHT
IF NUMBERP LAST :LEFT [OP (LIST "PRODUCT OPFORM :LEFT OPFORM :RIGHT)]
OP OPFORM (SE :LEFT "OF :RIGHT)
END

TO TST.PER :LEFT :RIGHT
OP (LIST "QUOTIENT ~
          OPFORM :LEFT ~
          OPFORM (IFELSE NUMBERP FIRST :RIGHT [:RIGHT] [FPUT 1 :RIGHT]))
END

TO TST.PERCENT :LEFT :RIGHT
IF NOT NUMBERP LAST :LEFT ~
   [SAY [INCORRECT USE OF PERCENT:] :LEFT TOPLEVEL]
OP OPFORM (SE BL :LEFT ((LAST :LEFT) / 100) :RIGHT)
END

TO TST.PERLESS :LEFT :RIGHT
IF NOT NUMBERP LAST :LEFT ~
   [SAY [INCORRECT USE OF PERCENT:] :LEFT TOPLEVEL]
OP (LIST "PRODUCT ~
          (OPFORM SE BL :LEFT ((100 - (LAST :LEFT)) / 100)) ~
          OPFORM :RIGHT)
END

TO TST.PLUS :LEFT :RIGHT
OP (LIST "SUM OPFORM :LEFT OPFORM :RIGHT)
END

TO TST.PLUSS :LEFT :RIGHT
OP TST.PLUS :LEFT :RIGHT
END

TO TST.SQUARE :LEFT :RIGHT
OP LIST "SQUARE OPFORM :RIGHT
END

TO TST.SQUARED :LEFT :RIGHT
OP LIST "SQUARE OPFORM :LEFT
END

TO TST.SUM :LEFT :RIGHT
LOCAL [ONE TWO THREE]
IF MATCH [^ONE AND ^TWO AND #THREE] :RIGHT ~
   [OP (LIST "SUM OPFORM :ONE OPFORM (SE "SUM :TWO "AND :THREE))]
IF MATCH [^ONE AND #TWO] :RIGHT ~
   [OP (LIST "SUM OPFORM :ONE OPFORM :TWO)]
SAY [SUM USED WRONG:] :RIGHT
TOPLEVEL
END

TO TST.TIMES :LEFT :RIGHT
IF EMPTYP :LEFT [SAY [INCORRECT USE OF TIMES:] :RIGHT TOPLEVEL]
OP (LIST "PRODUCT OPFORM :LEFT OPFORM :RIGHT)
END

TO TST.TOTHEPOWER :LEFT :RIGHT
OP (LIST "EXPT OPFORM :LEFT OPFORM :RIGHT)
END

TO UNITSTRING :EXPR
IF NUMBERP :EXPR [OP ROUNDOFF :EXPR]
IF EQUALP FIRST :EXPR "PRODUCT ~
   [OP SE (UNITSTRING FIRST BF :EXPR) (REDUCE "SE BF BF :EXPR)]
IF (AND (LISTP :EXPR) ~
         (NOT NUMBERP FIRST :EXPR) ~
         (NOT OPERATORP FIRST :EXPR)) ~
   [OP (SE 1 (SINGULAR FIRST :EXPR) (BF :EXPR))]
OP :EXPR
END

TO VAREQUAL :TARGET :VAR
PR []
PR [ASSUMING THAT]
PR (SE (LIST :TARGET) [IS EQUAL TO] (LIST :VAR))
OP (LIST "EQUAL :TARGET :VAR)
END

TO VARKEY :VAR
LOCAL "WORD
IF MATCH [NUMBER OF !WORD #] :VAR [OP :WORD]
OP FIRST :VAR
END

TO VARTERMS :EXPR
IF EMPTYP :EXPR [OP []]
IF NUMBERP :EXPR [OP []]
IF WORDP :EXPR [OP (LIST :EXPR)]
IF OPERATORP FIRST :EXPR [OP MAP.SE [VARTERMS ?] BF :EXPR]
OP (LIST :EXPR)
END

TO VARTEST :VARS
IF EMPTYP :VARS [OP []]
LOCAL [VAR BEG END]
MAKE "VAR FIRST :VARS
OP (SE (IFELSE MATCH [^BEG !:PRONOUN #END] :VAR ~
                 [VARTEST1 :VAR (SE :BEG "& :END) BF :VARS] ~
                 [[]]) ~
       (VARTEST1 :VAR (SE "# :VAR "#) BF :VARS) (VARTEST BF :VARS))
END

TO VARTEST1 :TARGET :PAT :VARS
OP MAP [VAREQUAL :TARGET ?] FILTER [MATCH :PAT ?] :VARS
END

TO VERB :WORD
OP MEMBERP :WORD [HAVE HAS GET GETS WEIGH WEIGHS]
END

TO MATCH :PAT :SEN
IF PREMATCH :PAT :SEN [OP RMATCH :PAT :SEN]
OP "FALSE
END

TO PREMATCH :PAT :SEN
IF EMPTYP :PAT [OP "TRUE]
IF LISTP FIRST :PAT [OP PREMATCH BF :PAT :SEN]
IF MEMBERP FIRST FIRST :PAT [! @ # ^ & ?] [OP PREMATCH BF :PAT :SEN]
IF EMPTYP :SEN [OP "FALSE]
IF MEMBERP FIRST :PAT :SEN [OP PREMATCH BF :PAT :SEN]
OP "FALSE
END

TO MATCH!
IF EMPTYP :SEN [OP "FALSE]
IF NOT TRY.PRED [OP "FALSE]
MAKE :SPECIAL.VAR FIRST :SEN
OP RMATCH BF :PAT BF :SEN
END

TO MATCH#
MAKE :SPECIAL.VAR []
OP #TEST #GATHER :SEN
END

TO #GATHER :SEN
IF EMPTYP :SEN [OP :SEN]
IF NOT TRY.PRED [OP :SEN]
MAKE :SPECIAL.VAR LPUT FIRST :SEN THING :SPECIAL.VAR
OP #GATHER BF :SEN
END

TO #TEST :SEN
IF RMATCH BF :PAT :SEN [OP "TRUE]
IF EMPTYP THING :SPECIAL.VAR [OP "FALSE]
OP #TEST2 FPUT LAST THING :SPECIAL.VAR :SEN
END

TO #TEST2 :SEN
MAKE :SPECIAL.VAR BL THING :SPECIAL.VAR
OP #TEST :SEN
END

TO MATCH&
OP &TEST MATCH#
END

TO &TEST :TF
IF EMPTYP THING :SPECIAL.VAR [OP "FALSE]
OP :TF
END

TO MATCH?
MAKE :SPECIAL.VAR []
IF EMPTYP :SEN [OP RMATCH BF :PAT :SEN]
IF NOT TRY.PRED [OP RMATCH BF :PAT :SEN]
MAKE :SPECIAL.VAR FIRST :SEN
IF RMATCH BF :PAT BF :SEN [OP "TRUE]
MAKE :SPECIAL.VAR []
OP RMATCH BF :PAT :SEN
END

TO MATCH@
MAKE :SPECIAL.VAR :SEN
OP @TEST []
END

TO @TEST :SEN
IF @TRY.PRED [IF RMATCH BF :PAT :SEN [OP "TRUE]]
IF EMPTYP THING :SPECIAL.VAR [OP "FALSE]
OP @TEST2 FPUT LAST THING :SPECIAL.VAR :SEN
END

TO @TEST2 :SEN
MAKE :SPECIAL.VAR BL THING :SPECIAL.VAR
OP @TEST :SEN
END

TO @TRY.PRED
IF LISTP :SPECIAL.PRED [OP RMATCH :SPECIAL.PRED THING :SPECIAL.VAR]
OP RUN LIST :SPECIAL.PRED THING :SPECIAL.VAR
END

TO MATCH^
MAKE :SPECIAL.VAR []
OUTPUT ^TEST :SEN
END

TO ^TEST :SEN
IF RMATCH BF :PAT :SEN [OUTPUT "TRUE]
IF EMPTYP :SEN [OUTPUT "FALSE]
IF NOT TRY.PRED [OUTPUT "FALSE]
MAKE :SPECIAL.VAR LPUT FIRST :SEN THING :SPECIAL.VAR
OUTPUT ^TEST BF :SEN
END

TO ALWAYS :X
OP "TRUE
END

TO ANYOF :SEN
OP ANYOF1 :SEN :IN.LIST
END

TO ANYOF1 :SEN :PATS
IF EMPTYP :PATS [OP "FALSE]
IF RMATCH FIRST :PATS :SEN [OP "TRUE]
OP ANYOF1 :SEN BF :PATS
END

TO IN :WORD
OP MEMBERP :WORD :IN.LIST
END

TO RMATCH :PAT :SEN
LOCAL [SPECIAL.VAR SPECIAL.PRED SPECIAL.BUFFER IN.LIST]
IF OR WORDP :PAT WORDP :SEN [OP "FALSE]
IF EMPTYP :PAT [OP EMPTYP :SEN]
IF LISTP FIRST :PAT [OP SPECIAL FPUT "!: :PAT :SEN]
IF MEMBERP FIRST FIRST :PAT [? # ! & @ ^] [OP SPECIAL :PAT :SEN]
IF EMPTYP :SEN [OP "FALSE]
IF EQUALP FIRST :PAT FIRST :SEN [OP RMATCH BF :PAT BF :SEN]
OP "FALSE
END

TO PARSE.SPECIAL :WORD :VAR
IF EMPTYP :WORD [OP LIST :VAR "ALWAYS]
IF EQUALP FIRST :WORD ": [OP LIST :VAR BF :WORD]
OP PARSE.SPECIAL BF :WORD WORD :VAR FIRST :WORD
END

TO QUOTED :THING
IF LISTP :THING [OP :THING]
OP WORD "" :THING
END

TO SET.IN
MAKE "IN.LIST FIRST BF :PAT
MAKE "PAT FPUT FIRST :PAT BF BF :PAT
END

TO SET.SPECIAL :LIST
MAKE "SPECIAL.VAR FIRST :LIST
MAKE "SPECIAL.PRED LAST :LIST
IF EMPTYP :SPECIAL.VAR [MAKE "SPECIAL.VAR "SPECIAL.BUFFER]
IF MEMBERP :SPECIAL.PRED [IN ANYOF] [SET.IN]
IF NOT EMPTYP :SPECIAL.PRED [STOP]
MAKE "SPECIAL.PRED FIRST BF :PAT
MAKE "PAT FPUT FIRST :PAT BF BF :PAT
END

TO SPECIAL :PAT :SEN
SET.SPECIAL PARSE.SPECIAL BF FIRST :PAT "
OP RUN FPUT WORD "MATCH FIRST FIRST :PAT []
END

TO TRY.PRED
IF LISTP :SPECIAL.PRED [OP RMATCH :SPECIAL.PRED FIRST :SEN]
OP RUN LIST :SPECIAL.PRED QUOTED FIRST :SEN
END

MAKE "ANN [MARY IS TWICE AS OLD AS ANN WAS WHEN MARY WAS AS OLD AS ANN IS NOW. ~
  IF MARY IS 24 YEARS OLD, HOW OLD IS ANN?]
MAKE "GUNS [THE NUMBER OF SOLDIERS THE RUSSIANS HAVE IS ~
  ONE HALF OF THE NUMBER OF GUNS THEY HAVE. THEY HAVE 7000 GUNS. ~
  HOW MANY SOLDIERS DO THEY HAVE?]
MAKE "JET [THE DISTANCE FROM NEW YORK TO LOS ANGELES IS 3000 MILES. ~
  IF THE AVERAGE SPEED OF A JET PLANE IS 600 MILES PER HOUR, ~
  FIND THE TIME IT TAKES TO TRAVEL FROM NEW YORK TO LOS ANGELES BY JET.]
MAKE "NUMS [A NUMBER IS MULTIPLIED BY 6 . THIS PRODUCT IS INCREASED BY 44 . ~
  THIS RESULT IS 68 . FIND THE NUMBER.]
MAKE "RADIO [THE PRICE OF A RADIO IS $69.70. ~
  IF THIS PRICE IS 15 PERCENT LESS THAN THE MARKED PRICE, FIND THE MARKED PRICE.]
MAKE "SALLY [THE SUM OF SALLY'S SHARE OF SOME MONEY AND FRANK'S SHARE IS $4.50. ~
  SALLY'S SHARE IS TWICE FRANK'S. FIND FRANK'S AND SALLY'S SHARE.]
MAKE "SHIP [THE GROSS WEIGHT OF A SHIP IS 20000 TONS. ~
  IF ITS NET WEIGHT IS 15000 TONS, WHAT IS THE WEIGHT OF THE SHIPS CARGO?]
MAKE "SPAN [IF 1 SPAN IS 9 INCHES, AND 1 FATHOM IS 6 FEET, ~
  HOW MANY SPANS IS 1 FATHOM?]
MAKE "SUMTWO [THE SUM OF TWO NUMBERS IS 96, ~
  AND ONE NUMBER IS 16 LARGER THAN THE OTHER NUMBER. FIND THE TWO NUMBERS.]
MAKE "TOM [IF THE NUMBER OF CUSTOMERS TOM GETS IS ~
  TWICE THE SQUARE OF 20 PER CENT OF THE NUMBER OF ADVERTISEMENTS HE RUNS, ~
  AND THE NUMBER OF ADVERTISEMENTS HE RUNS IS 45, ~
  WHAT IS THE NUMBER OF CUSTOMERS TOM GETS?]
MAKE "UNCLE [BILL'S FATHER'S UNCLE IS TWICE AS OLD AS BILL'S FATHER. ~
  2 YEARS FROM NOW BILL'S FATHER WILL BE 3 TIMES AS OLD AS BILL. ~
  THE SUM OF THEIR AGES IS 92 . FIND BILL'S AGE.]

PPROP "DISTANCE "EQNS ~
  [[EQUAL [DISTANCE] [PRODUCT [SPEED] [TIME]]] ~
   [EQUAL [DISTANCE] [PRODUCT [GAS CONSUMTION] [NUMBER OF GALLONS OF GAS USED]]]]
PPROP "FEET "EQNS ~
  [[EQUAL [PRODUCT 1 [FEET]] [PRODUCT 12 [INCHES]]] ~
   [EQUAL [PRODUCT 1 [YARDS]] [PRODUCT 3 [FEET]]]]
PPROP "FEET "SING "FOOT
PPROP "FOOT "PLURAL "FEET
PPROP "GALLONS "EQNS ~
  [[EQUAL [DISTANCE] [PRODUCT [GAS CONSUMTION] [NUMBER OF GALLONS OF GAS USED]]]]
PPROP "GAS "EQNS ~
  [[EQUAL [DISTANCE] [PRODUCT [GAS CONSUMTION] [NUMBER OF GALLONS OF GAS USED]]]]
PPROP "INCH "PLURAL "INCHES
PPROP "INCHES "EQNS [[EQUAL [PRODUCT 1 [FEET]] [PRODUCT 12 [INCHES]]]]
PPROP "PEOPLE "SING "PERSON
PPROP "PERSON "PLURAL "PEOPLE
PPROP "SPEED "EQNS [[EQUAL [DISTANCE] [PRODUCT [SPEED] [TIME]]]]
PPROP "TIME "EQNS [[EQUAL [DISTANCE] [PRODUCT [SPEED] [TIME]]]]
PPROP "YARDS "EQNS [[EQUAL [PRODUCT 1 [YARDS]] [PRODUCT 3 [FEET]]]]